home *** CD-ROM | disk | FTP | other *** search
/ Aminet 33 / Aminet 33 - October 1999.iso / Aminet / util / misc / mvslink.lha / Mvslink / Source / SUBslink.amos / SUBslink.amosSourceCode < prev   
Encoding:
AMOS Source Code  |  1999-07-11  |  5.7 KB  |  206 lines
  1. ' SubSlink v1.2  by Vettorello Marco     11/07/1999  
  2. '  
  3. ' vettorel@psy.unipd.it  
  4. '  
  5. ' freeware version 
  6. ' You can change,use,modify,spread this code as you like 
  7. '
  8. ' this my last version. Development is over. 
  9. '
  10. Set Buffer 4
  11. 'Load "Work:AMOS_Pro/My_Program/Slink/SUBSlinkv2.abk",20 
  12. 'Load "Work:AMOS_Pro/My_Program/VOCabo/progress.abk",21
  13. Dim FB(4)
  14. Dim TB(4)
  15. Dim SUB$(4)
  16. Global FB(),TB(),MESS$,INFO$
  17. Global SUB$(),BYTES,BYTES$,FILE$,SRG$
  18.  Extension_24_0080 0
  19.  Extension_24_02C8 
  20.  Extension_24_0992 True,True
  21.  Extension_24_0018 1,1,20
  22.  Extension_24_03D6 
  23.  Extension_24_0402 1,"SubSlink tool v1.2","SubSlink v1.2  ï¿½1997-1999 Vettorello Marco"
  24. MESS$="Chose a file."
  25.  Extension_24_009E 1,8,0,Varptr(MESS$)
  26. For X=1 To 4
  27.    FB(X)=0
  28.    TB(X)=0
  29.    SUB$(X)=""
  30. Next 
  31. FILE$=""
  32. For X=14 To 21
  33.     Extension_24_009E 1,X,0,0
  34. Next 
  35. For X=4 To 7
  36.     Extension_24_009E 1,X,-1,1
  37. Next 
  38. For X=14 To 21
  39.     Extension_24_009E 1,X,-1,1
  40. Next 
  41. For X=0 To 3
  42.     Extension_24_009E 1,X,0,Varptr(MESS$)
  43. Next 
  44.  
  45. INFO$="Waiting for comands."
  46.  Extension_24_009E 1,12,0,Varptr(INFO$)
  47. On Error Proc ERRH
  48.  
  49. Do 
  50.    A= Extension_24_0034 
  51.    If A=4
  52.       SUB$(1)= Extension_24_0162("Choose destination file","","","~(#?.info)")
  53.       If Extension_24_0178 <>""
  54.           Extension_24_009E 1,3,0,Varptr(SUB$(1))
  55.           Extension_24_009E 1,14,-1,0
  56.           Extension_24_009E 1,15,-1,0
  57.           Extension_24_009E 1,5,-1,0
  58.       End If 
  59.    Else If A=5
  60.       SUB$(2)= Extension_24_0162("Choose destination file","","","~(#?.info)")
  61.       If Extension_24_0178 <>""
  62.           Extension_24_009E 1,0,0,Varptr(SUB$(2))
  63.           Extension_24_009E 1,16,-1,0
  64.           Extension_24_009E 1,17,-1,0
  65.           Extension_24_009E 1,6,-1,0
  66.       End If 
  67.    Else If A=6
  68.       SUB$(3)= Extension_24_0162("Choose destination file","","","~(#?.info)")
  69.       If Extension_24_0178 <>""
  70.           Extension_24_009E 1,1,0,Varptr(SUB$(3))
  71.           Extension_24_009E 1,18,-1,0
  72.           Extension_24_009E 1,19,-1,0
  73.           Extension_24_009E 1,7,-1,0
  74.       End If 
  75.    Else If A=7
  76.       SUB$(4)= Extension_24_0162("Choose destination file","","","~(#?.info)")
  77.       If Extension_24_0178 <>""
  78.           Extension_24_009E 1,2,0,Varptr(SUB$(4))
  79.           Extension_24_009E 1,20,-1,0
  80.           Extension_24_009E 1,21,-1,0
  81.       End If 
  82.    Else If A=9
  83.       _SETSOURCE
  84.    Else If A=10
  85.       If Exist(FILE$)=True
  86.          _SUBSLINK
  87.       End If 
  88.    Else If A=13
  89.       _RESET
  90.    Else If A=-1 or A=11
  91.       _QUIT
  92.    Else If A=-2
  93.       Repeat 
  94.          If Extension_24_0070(1)=1 and Extension_24_0070(2)=1
  95.             _SETSOURCE
  96.          End If 
  97.          If Extension_24_0070(1)=1 and Extension_24_0070(2)=3
  98.             ABOUT= Extension_24_0150(" ABOUT","SubSlink v1.2"+Chr$(10)+"by Vettorello Marco "+Chr$(10)+"� 1997-1999","Ok")
  99.          End If 
  100.          If Extension_24_0070(1)=1 and Extension_24_0070(2)=5
  101.             _QUIT
  102.          End If 
  103.       Until Extension_24_0070(4)=False
  104.    End If 
  105. Loop 
  106. Procedure _QUIT
  107.    QUIT= Extension_24_0150(" Message","Sure ot quit?","Yes|No")
  108.    If QUIT=1
  109.        Extension_24_0130 
  110.       End 
  111.    End If 
  112. End Proc
  113. Procedure _RESET
  114.    For X=1 To 4
  115.       FB(X)=0
  116.       TB(X)=0
  117.       SUB$(X)=""
  118.       FILE$=""
  119.    Next 
  120.    For X=14 To 21
  121.        Extension_24_009E 1,X,0,0
  122.    Next 
  123.    For X=4 To 7
  124.        Extension_24_009E 1,X,-1,1
  125.    Next 
  126.    For X=14 To 21
  127.        Extension_24_009E 1,X,-1,1
  128.    Next 
  129.    For X=0 To 3
  130.        Extension_24_009E 1,X,0,Varptr(MESS$)
  131.    Next 
  132.    INFO$="Re-initialized!"
  133.     Extension_24_009E 1,12,0,Varptr(INFO$)
  134.     Extension_24_009E 1,8,0,Varptr(MESS$)
  135. End Proc
  136. Procedure _SETSOURCE
  137.    On Error Proc ERRH
  138.    FILE$= Extension_24_0162("Choose the SOURCE file","","","~(#?.info)")
  139.    If Extension_24_0178 <>""
  140.        Extension_24_009E 1,8,0,Varptr(FILE$)
  141.       Open In 1,FILE$
  142.       BYTES=Lof(1)
  143.       Close 
  144.       BYTES$=Str$(BYTES)
  145.       INFO$="The file is "+BYTES$+" bytes long."
  146.        Extension_24_009E 1,12,0,Varptr(INFO$)
  147.        Extension_24_009E 1,4,-1,0
  148.       SRG$= Extension_24_0178 
  149.    End If 
  150. End Proc
  151. Procedure _SUBSLINK
  152.    On Error Proc ERRH
  153.    FB(1)= Extension_24_0368(1,14)
  154.    TB(1)= Extension_24_0368(1,15)
  155.    FB(2)= Extension_24_0368(1,16)
  156.    TB(2)= Extension_24_0368(1,17)
  157.    FB(3)= Extension_24_0368(1,18)
  158.    TB(3)= Extension_24_0368(1,19)
  159.    FB(4)= Extension_24_0368(1,20)
  160.    TB(4)= Extension_24_0368(1,21)
  161.    For CHK=1 To 4
  162.       If FB(CHK)<0
  163.          FB(CHK)=0
  164.       Else If TB(CHK)>BYTES
  165.          TB(CHK)=BYTES
  166.       Else If FB(CHK)>TB(CHK)
  167.          FB(CHK)=0 : TB(CHK)=1
  168.       End If 
  169.    Next 
  170.    INFO$="Loading file into memory."
  171.     Extension_24_009E 1,12,0,Varptr(INFO$)
  172.     Extension_24_0024 2,1,21, Extension_24_00F8 , Extension_24_010A 
  173.     Extension_24_0402 2,"Slinking file",""
  174.    INFO$=" Slinking file in progress..."
  175.     Extension_24_009E 2,1,0,Varptr(INFO$)
  176.    Open In 5,FILE$
  177.    For A=1 To 4
  178.       If SUB$(A)<>""
  179.          LLFF=TB(A)-FB(A)
  180.          If Chip Free>LLFF or Fast Free>LLFF
  181.             Reserve As Work 7,LLFF
  182.             Pof(5)=FB(A)
  183.             Sload 5 To Start(7),LLFF
  184.             Bsave SUB$(A)+"_"+Str$(A)-" ",Start(7) To Start(7)+LLFF
  185.             INFO$="Saving slinked part: "+Str$(A)
  186.              Extension_24_009E 1,12,0,Varptr(INFO$)
  187.              Extension_24_009E 2,0,0,A*25
  188.             Erase 7
  189.          Else 
  190.             REQ= Extension_24_0150(" Error!","Memory overflow.","Ops")
  191.          End If 
  192.       End If 
  193.    Next 
  194.     Extension_24_009E 2,0,0,100
  195.    Erase 7
  196.    Close 
  197.    DAM= Extension_24_0042(2)
  198.    INFO$="Operation succesfully terminated!"
  199.     Extension_24_009E 1,12,0,Varptr(INFO$)
  200.    REQ= Extension_24_0150(" Message","Operation terminated.","Ok")
  201. End Proc
  202. Procedure ERRH
  203.    ER$=Str$(Errn)+"  "+Err$(Errn)
  204.    A= Extension_24_0150("ERROR!",Chr$(10)+"An error has occoured :"+Chr$(10)+Chr$(10)+ER$+Chr$(10)+Chr$(10)+"Plese contact the author,"+Chr$(10)+"see docs for address.","Contact the author.")
  205.    Resume Next 
  206. End Proc